---
title: "Data Analysis for 'Partisan Reactions to Endogenous Election Timing'"
author: "M. Higashijima, N. Shimizu, H. Washida, and Y Yanai"
date: "2025-10-20 (revised: 2025-10-31)"
execute:
  fig-height: 6
  fig-width: 6
  warning: false
format: 
  html:
    page-layout: article
    embed-resources: true
    toc: true
---


## Preparation

### Load packages
```{r}
#| message: false
library(tidyverse)
library(knitr)
library(kableExtra)
library(projoint)
library(cjoint)
theme_set(theme_gray(base_size = 11,
                     base_family = "IPAexGothic"))
```

:::{.callout-note}
We updated this file to use the latest versions of the packgeas required as of October 31, 2025. We use `renv` to make our results reproducible.
:::

Session Info
```{r}
sessionInfo()
```


### Read the data

Data of the first survey, which was fieled in March 2021.
```{r}
D1 <-read_rds("data/et_survey_2021march.Rds")
```


Data of the second survey, which was conducted in January, 2022.
```{r}
D2 <- read_rds("data/et_survey_2022jan.Rds")
```

:::{.callout-note}
Note that you have to transform some variables into factor if you use csv versions of the data.
:::


### Data pre-processing

Create a variable measuring political knowledge
```{r}
D2 <- D2 |> 
  mutate(know_1t = ifelse(know_1 == "3", 1, 0),
         know_2t = ifelse(know_2 == "1", 1, 0),
         know_3t = ifelse(know_3 == "6", 1, 0),
         know_4_1t = ifelse(know_4_1 == "1", 1, 0),
         know_4_2t = ifelse(know_4_2 == "2", 1, 0),
         know_4_3t = ifelse(know_4_3 == "3", 1, 0),
         know_4_4t = ifelse(know_4_4 == "4", 1, 0)) |> 
  mutate(know_sum = know_1t + know_2t + know_3t + 
           know_4_1t + know_4_2t + know_4_3t + know_4_4t)
```

Examine stats of the new var `know_sum`: 
```{r}
summary(D2$know_sum)
```

Define the respondents who scored 5 and higher as "knowledgeble voters."
Create the dataset containing those "knowledgeable" respondents only: `Dk`
```{r}
Dk <- D2 |> 
  filter(know_sum >= 5)
```


## Data analysis

Data frame (tibble) we use:
- D1: Data of Survey 1 (March, 2021)
- D2: Data of Survey 2 (Jaunary, 2022)
- Dk: Subset of D2 that contains knowledgeble voters only


### Overall marginal means

Set attributes for the conjoint experiment in the first survey.
```{r}
attr1_all <- c("remain", "reason", "econ_policy", "achievement", 
               "popularity", "newspaper", "growth", "opposition")
```


#### Survey 1

Prepare data for projoint.
```{r}
#| message: false
pj1_all <- make_projoint_data(
  .dataframe      = D1,
  .attribute_vars = intersect(attr1_all, names(D1)),
  .id_var         = "ID",
  .task_var       = "task",
  .profile_var    = "profile",
  .selected_var   = "selected")
```

Estimate IRR
```{r}
pred_irr_1 <- predict_tau(pj1_all) 
summary(pred_irr_1)
plot(pred_irr_1)
IRR_D1 <- pred_irr_1$irr$predicted[1]
```

Calculate marginal means with correting measurement-error biases
```{r}
fit_mm_all1 <- projoint(
  pj1_all,
  .structure = "profile_level",
  .estimand  = "mm",
  .se_method = "analytical",
  .irr       = IRR_D1)

mm_all1 <- summary(fit_mm_all1) |> 
  filter(estimand == "mm_corrected") |> 
  separate_wider_delim(att_level_choose, ":",
                       names = c("attribute", "level")) |> 
  select(attribute, level, estimate, se, conf.low, conf.high)
```


Labeling
```{r}
attr1 <- tribble(
  ~attribute, ~attr,
  "att1",     "Achievement",
  "att2",     "Policy",
  "att3",     "Economy",
  "att4",     "Newspaper Eval.",
  "att5",     "Opposition",
  "att6",     "Cabinet Approval",
  "att7",     "Reason",
  "att8",     "Remaining Term")

level1 <- bind_rows(
  tibble(attribute = "att1", 
         level = paste0("level", 1:3), 
         lev = c("Hardly", "Half", "Mostly")), 
  tibble(attribute = "att2", 
         level = paste0("level", 1:3), 
         lev = c("Nothing", "Stimulus", "Counter unemployment")), 
  tibble(attribute = "att3",
         level = paste0("level", 1:4), 
         lev = c("Good to bad", "Bad to bad", 
                 "Good to good","Bad to good")), 
  tibble(attribute = "att4",
         level = paste0("level",1:2), 
         lev = c("Expected","Surprised")), 
  tibble(attribute = "att5",
         level = paste0("level", 1:5), 
         lev = c("Many oppositions", "Under negotiation", 
                 "CDP-JCP", "CDP-DPP", "One opposition")), 
  tibble(attribute = "att6", 
         level = paste0("level", 1:5), 
         lev = c("20%", "30%", "40%", "50%", "60%")), 
  tibble(attribute = "att7",
         level = paste0("level", 1:8),
         lev = c("No-confidence", 
                 "New issue", 
                 "Policy change", 
                 "Policy rejected", 
                 "Leader change",
                 "PM strength", 
                 "Gov't strength",
                 "Full term")), 
  tibble(attribute = "att8", 
         level = paste0("level", 1:5),
         lev = c("3 yrs", "2 yrs", "1 yr", "1 mo", "0"))
)
```


Set the labels and specify the display order
```{r}
mm_all1b <- mm_all1 |> 
  left_join(attr1, by = c("attribute"))

mm_all1c <- mm_all1b |> 
  left_join(level1, by = c("attribute", "level")) |> 
  select(!c(attribute, level)) |> 
  rename(attribute = attr, level = lev)

mm_all1d <- mm_all1c |> 
  mutate(attribute = fct_relevel(.f = attribute,
                                 "Remaining Term", "Newspaper Eval.",
                                 "Reason", "Cabinet Approval",
                                 "Opposition", "Economy", 
                                 "Policy", "Achievement"))

mm_all1d <- mm_all1d |> 
  mutate(level = fct_relevel(.f = level, 
    "Hardly", "Half", "Mostly", 
    "Nothing", "Stimulus", "Counter unemployment", 
    "Good to bad", "Bad to bad", "Good to good", "Bad to good", 
    "Many oppositions", "Under negotiation", 
    "CDP-JCP", "CDP-DPP", "One opposition", 
    "20%", "30%", "40%", "50%", "60%", 
    "No-confidence", "New issue", "Policy change", "Policy rejected", 
    "Leader change", "PM strength", "Gov't strength", "Full term", 
    "Expected", "Surprised", 
    "0", "1 mo", "1 yr", "2 yrs", "3 yrs"))
```


Plot the estimates and confidence intervals of the marginal means
```{r}
conjoint1_all <- mm_all1d |> 
  ggplot() +
  geom_vline(xintercept = 0.5, linetype = "dashed") + 
  geom_pointrange(aes(x = estimate, y = level, 
                      xmin = conf.low, xmax = conf.high),
                  size = 0.4) +
  facet_grid(attribute ~ ., scales = "free", space = "free") + 
  scale_x_continuous(limits = c(0.38, 0.69), 
                     breaks = seq(0.4, 0.65, by = 0.05)) +
  labs(x = "Marginal mean and 95% confidence interval", 
       y = "Level") + 
  theme(strip.text.y = element_text(angle = 0))

plot(conjoint1_all)
```

Save to PDF
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_A1.pdf",
          family = "sans", width = 7, height = 8)
print(conjoint1_all)
dev.off()
```

Table A2
```{r}
#| eval: false
mm_all1d |> 
  select(attribute, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_A2.tex")
```




#### Survey 2


Set the attributes of the conjoint experiment in the second survey.
```{r}
attr2_all <- c("remain", "reason", "econ_policy",
               "how", "popularity", "newspaper", "growth", "opposition")
```


Prepare data for projoint.
```{r}
#| message: false
pj2_all <- make_projoint_data(
  .dataframe      = D2,
  .attribute_vars = intersect(attr2_all, names(D2)),
  .id_var         = "ID",
  .task_var       = "task",
  .profile_var    = "profile",
  .selected_var   = "selected")
```

Estimate IRR
```{r}
pred_irr_2 <- predict_tau(pj2_all) 
summary(pred_irr_2)
plot(pred_irr_2)
IRR_D2 <- pred_irr_2$irr$predicted[1]
```

Calculate marginal means with correting measurement-error biases
```{r}
fit_mm_all2 <- projoint(
  pj2_all,
  .structure = "profile_level",
  .estimand  = "mm",
  .se_method = "analytical",
  .irr       = IRR_D2)

mm_all2 <- summary(fit_mm_all2) |> 
  filter(estimand == "mm_corrected") |> 
  separate_wider_delim(att_level_choose, ":",
                       names = c("attribute", "level")) |> 
  select(attribute, level, estimate, se, conf.low, conf.high)
```

Labeling
```{r}
attr2 <- tribble(
  ~attribute, ~attr,
  "att1",     "Policy",
  "att2",     "Economy",
  "att3",     "Decision",
  "att4",     "Newspaper Eval.",
  "att5",     "Opposition",
  "att6",     "Cabinet Approval",
  "att7",     "Reason",
  "att8",     "Remaining Term")

level2 <- bind_rows(
  tibble(attribute = "att1", 
         level = paste0("level", 1:3), 
         lev = c("Nothing", "Stimulus","Counter unemployment")), 
  tibble(attribute = "att2",
         level = paste0("level", 1:3), 
         lev = c("Better", "Same", "Worse")), 
  tibble(attribute = "att3",
         level = paste0("level", 1:4), 
         lev = c("PM alone", "PM backed by LDP", 
                 "PM backed by LDP-Komei", "Term expired")), 
  tibble(attribute = "att4", 
         level = paste0("level", 1:2), 
         lev = c("Expected", "Surprised")), 
  tibble(attribute = "att5",
         level = paste0("level", 1:5), 
         lev = c("Many oppositions", 
                 "Under negotiation", 
                 "CDP-JCP", 
                 "CDP-DPP", 
                 "One opposition")), 
  tibble(attribute = "att6", 
         level = paste0("level", 1:5), 
         lev = c("20%", "30%", "40%", "50%", "60%")), 
  tibble(attribute = "att7", 
         level = paste0("level", 1:8),
         lev = c("Leader change",
                 "No-confidence", 
                 "Policy rejected", 
                 "New issue", 
                 "Policy change", 
                 "PM strength", 
                 "Gov't strength",
                 "Full term")), 
  tibble(attribute = "att8", 
         level = paste0("level", 1:7),
         lev = c("0","0.5 yrs","1 yr","1.5 yrs","2 yrs",
                 "2.5 yrs","3 yrs")))
```


Set the labels and specify the order of attributes
```{r}
mm_all2b <- mm_all2 |> 
  left_join(attr2, by = c("attribute"))

mm_all2c <- mm_all2b |> 
  left_join(level2, by = c("attribute", "level")) |> 
  select(!c(attribute, level)) |> 
  rename(attribute = attr, level = lev)

mm_all2d <- mm_all2c |> 
  mutate(attribute = fct_relevel(
    .f = attribute,
    "Remaining Term", "Newspaper Eval.", "Reason", "Cabinet Approval",
    "Opposition", "Economy", "Policy", "Decision"))

mm_all2d <- mm_all2d |> 
  mutate(level = fct_relevel(
    .f = level, 
    "PM alone", "PM backed by LDP", "PM backed by LDP-Komei", "Term expired", 
    "Nothing", "Stimulus", "Counter unemployment", 
    "Better", "Same", "Worse", 
    "Many oppositions", "Under negotiation", 
    "CDP-JCP", "CDP-DPP", "One opposition", 
    "20%", "30%", "40%", "50%", "60%", 
    "Leader change", "No-confidence", "Policy rejected", "New issue", 
    "Policy change", "PM strength", "Gov't strength", "Full term", 
    "Expected", "Surprised", 
    "0", "0.5 yrs", "1 yr", "1.5 yrs", "2 yrs", "2.5 yrs", "3 yrs"))
```


Plot
```{r}
conjoint2_all <- mm_all2d |> 
  ggplot() +
  geom_vline(xintercept = 0.5, linetype = "dashed") + 
  geom_pointrange(aes(x = estimate, 
                      y = level, 
                      xmin = conf.low, 
                      xmax = conf.high), 
                  size = 0.4) +
  facet_grid(attribute ~ ., scales = "free", space = "free") + 
  scale_x_continuous(limits = c(0.35, 0.725), 
                     breaks = seq(0.35, 0.7, by = 0.05)) +
  labs(x = "Marginal mean and 95% confidence interval", 
       y = "Level") + 
  theme(strip.text.y = element_text(angle = 0))

plot(conjoint2_all)
```

Figure 1
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_1.pdf",
          family = "sans", width = 7, height = 8)
print(conjoint2_all)
dev.off()

png(file = "figs/Figure_1.png", res = 600,
    width = 7, height = 8, unit = "in")
print(conjoint2_all)
dev.off()
```

Table C3
```{r}
#| eval: false
mm_all2d |> 
  select(attribute, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_C3.tex")
```


#### Knowledgeable voters

Projoint data
```{r}
#| message: false
pj3_all <- make_projoint_data(
  .dataframe      = Dk,
  .attribute_vars = intersect(attr2_all, names(Dk)),
  .id_var         = "ID",
  .task_var       = "task",
  .profile_var    = "profile",
  .selected_var   = "selected")
```

Estimate IRR
```{r}
pred_irr_k <- predict_tau(pj3_all) 
summary(pred_irr_k)
plot(pred_irr_k)
IRR_Dk <- pred_irr_k$irr$predicted[1]
```

Calculate MM
```{r}
fit_mm_all3 <- projoint(
  pj3_all,
  .structure = "profile_level",
  .estimand  = "mm",
  .se_method = "analytical",
  .irr       = IRR_Dk)

mm_all3 <- summary(fit_mm_all3) |> 
  filter(estimand == "mm_corrected") |> 
  separate_wider_delim(att_level_choose, 
                       ":", names = c("attribute", "level")) |> 
  select(attribute, level, estimate, se, conf.low, conf.high)
```

Labeling
```{r}
mm_all3b <- mm_all3 |> 
  left_join(attr2, by = c("attribute"))

mm_all3c <- mm_all3b |> 
  left_join(level2, by = c("attribute", "level")) |> 
  select(!c(attribute, level)) |> 
  rename(attribute = attr, level = lev)

mm_all3d <- mm_all3c |> 
  mutate(attribute = fct_relevel(
    .f = attribute,
    "Remaining Term", "Newspaper Eval.", "Reason", "Cabinet Approval",
    "Opposition", "Economy", "Policy", "Decision"))

mm_all3d <- mm_all3d |> 
  mutate(level = fct_relevel(
    .f = level,
    "PM alone", "PM backed by LDP", "PM backed by LDP-Komei", "Term expired", 
    "Nothing", "Stimulus", "Counter unemployment", 
    "Better", "Same", "Worse", 
    "Many oppositions", "Under negotiation", "CDP-JCP", "CDP-DPP", "One opposition", 
    "20%", "30%", "40%", "50%", "60%", 
    "Leader change", "No-confidence", "Policy rejected", "New issue", 
    "Policy change", "PM strength", "Gov't strength", "Full term", 
    "Expected", "Surprised", 
    "0", "0.5 yrs", "1 yr", "1.5 yrs", "2 yrs", "2.5 yrs", "3 yrs"))

```


Plot marginal means and confidence intervals
```{r}
conjoint2_know <- mm_all3d |> 
  ggplot() +
  geom_vline(xintercept = 0.5, linetype = "dashed") + 
  geom_pointrange(aes(x = estimate, y = level, 
                       xmin = conf.low, xmax = conf.high), 
                  size = 0.4) +
  facet_grid(attribute ~ ., scales = "free", space = "free") + 
  scale_x_continuous(limits = c(0.3, 0.8), 
                     breaks = seq(0.3, 0.8, by = 0.1)) +  
  labs(x = "Marginal mean and 95% confidence interval", 
       y = "Level") + 
  theme(strip.text.y = element_text(angle = 0))

plot(conjoint2_know)
```

Save to PDF: Figure B1
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_B1.pdf",
          family = "sans", width = 7, height = 8)
print(conjoint2_know)
dev.off()
```

Table B1
```{r}
#| eval: false
mm_all3d |> 
  select(attribute, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_B1.tex")
```


### Overal AMCE

#### Survey 1

Specify the order of levelss in each attribute and set the reference level.
```{r}
D1b <- D1 |> 
  mutate(
    remain      = fct_relevel(.f = remain,
                              "0", "1 mo", "1 yr", "2 yrs", "3 yrs"),
    newspaper   = fct_relevel(.f = newspaper,   
                              "expected", "surprised"),
    reason      = fct_relevel(.f = reason,
                              "no-confidence", 
                              "new issue", 
                              "policy change", 
                              "policy rejected", 
                              "leader change", 
                              "PM strength", 
                              "gov't strength",
                              "full term"),
    popularity  = fct_relevel(.f = popularity,  
                              "20%", "30%", "40%", "50%", "60%"),
    opposition  = fct_relevel(.f = opposition,  
                              "many oppositions", 
                              "under negotiation", 
                              "CDP-JCP", 
                              "CDP-DPP", 
                              "one opposition"),
    growth      = fct_relevel(.f = growth,      
                              "good to bad", 
                              "bad to bad", 
                              "good to good", 
                              "bad to good"),
    econ_policy = fct_relevel(.f = econ_policy, 
                              "nothing", 
                              "stimulus", 
                              "counter unemployment"),
    achievement = fct_relevel(.f = achievement,    
                              "hardly", 
                              "half", 
                              "mostly"))
```


Make design matrix for cjoint's `amce`
```{r}
attribute_list <- list(
   remain = c("0", "1 mo", "1 yr", "2 yrs", "3 yrs"),
   newspaper = c("expected", "surprised"),
   reason = c("no-confidence",
              "new issue", 
              "policy change", 
              "policy rejected", 
              "leader change", 
              "PM strength", 
              "gov't strength",
              "full term"),
    popularity = c("20%", "30%", "40%", "50%", "60%"),
    opposition = c("many oppositions", 
                   "under negotiation", 
                   "CDP-JCP", 
                   "CDP-DPP", 
                   "one opposition"),
    growth = c("good to bad", 
               "bad to bad", 
               "good to good", 
               "bad to good"),
    econ_policy = c("nothing", "stimulus", "counter unemployment"),
    achievement = c("hardly", "half", "mostly")
)

constraint_list <- list()
constraint_list[[1]] <- list(
  remain = c("0"),
  reason = c("no-confidence",
             "new issue", 
             "policy change", 
             "policy rejected", 
             "leader change", 
             "PM strength", 
             "gov't strength"))

design_obj <- makeDesign(
  type = "constraints",
  attribute.levels = attribute_list,
  constraints = constraint_list
)
```

Estimate AMCE by cjoint's `amce`
```{r}
amce_e1 <- amce(
  selected ~ remain + newspaper + reason + popularity + opposition + 
    growth + econ_policy + achievement,
  data = D1b,
  cluster = TRUE,
  respondent.id = "ID",
  design = design_obj,
  baseline = list(remain = "1 yr",
                  newspaper = "expected",
                  reason = "no-confidence",
                  popularity = "20%",
                  opposition = "many oppositions",
                  growth = "good to bad",
                  econ_policy = "nothing",
                  achievement = "hardly"))
plot(amce_e1)
```

Organize the results
```{r}
amce_all1 <- summary(amce_e1)$amce |> 
  select(Attribute, Level, Estimate, `Std. Err`) |> 
  rename(attribute = Attribute,
         level = Level,
         estimate = Estimate,
         se = `Std. Err`) |> 
  mutate(conf.low = estimate - 2 * se,
         conf.high = estimate + 2 * se)
```


Labeling
```{r}
attr1_amce <- tribble(
  ~attribute,     ~attr,
  "achievement",  "Achievement (Ref. Hardly)",
  "econ_policy",  "Policy (Ref. Nothing)",
  "growth",       "Economy (Ref. Good to bad)",
  "newspaper",    "Newspaper Eval. (Ref. Expected)",
  "opposition",   "Opposition (Ref. Many oppositions)",
  "popularity",   "Cabinet Approval (Ref. 20%)",
  "reason",       "Reason (Ref. No confidence)",
  "remain",       "Remaining Term (Ref. 1 yr)")

level1_amce <- bind_rows(
  tibble(attribute = "achievement", 
         level = c("half", "mostly"),
         lev = c("Half", "Mostly")), 
  tibble(attribute = "econ_policy", 
         level = c("stimulus", "counter unemployment"), 
         lev = c("Stimulus", "Counter unemployment")), 
  tibble(attribute = "growth", 
         level =c("bad to bad", "good to good", "bad to good"), 
         lev = c("Bad to bad", "Good to good", "Bad to good")), 
  tibble(attribute = "newspaper", 
         level = "surprised", 
         lev = c("Surprised")), 
  tibble(attribute = "opposition", 
         level = c("under negotiation", "CDP-JCP", 
                   "CDP-DPP", "one opposition"),
         lev = c("Under negotiation", "CDP-JCP", 
                 "CDP-DPP", "One opposition")), 
  tibble(attribute = "popularity", 
         level = c("30%","40%","50%","60%"), 
         lev = c("30%","40%","50%","60%")), 
  tibble(attribute = "reason", 
         level = c("new issue", 
                   "policy change", 
                   "policy rejected", 
                   "leader change", 
                   "PM strength", 
                   "gov't strength",
                   "full term"),
         lev = c("New issue", "Policy change", 
                "Policy rejected", "Leader change",
                "PM strength", "Gov't strength",
                "Full term")), 
  tibble(attribute = "remain", 
         level = c("0", "1 mo",  "2 yrs", "3 yrs"),
         lev = c("0", "1 mo", "2 yrs", "3 yrs")))
```


Set the label and specify the order
```{r}
amce_all1b <- amce_all1 |> 
  left_join(attr1_amce, by = c("attribute"))

amce_all1c <- amce_all1b |> 
  left_join(level1_amce, by = c("attribute", "level")) |> 
  select(!c(attribute, level)) |> 
  rename(attribute = attr, level = lev)

amce_all1d <- amce_all1c |> 
  mutate(attribute = fct_relevel(
    .f = attribute,
    "Remaining Term (Ref. 1 yr)", "Newspaper Eval. (Ref. Expected)", 
    "Reason (Ref. No confidence)", "Cabinet Approval (Ref. 20%)",
    "Opposition (Ref. Many oppositions)", 
    "Economy (Ref. Good to bad)", "Policy (Ref. Nothing)"))

amce_all1d <- amce_all1d |> 
  mutate(level = fct_relevel(
    .f = level, 
    "Half", "Mostly", 
    "Stimulus", "Counter unemployment", 
    "Bad to bad", "Good to good", "Bad to good", 
    "Under negotiation", "CDP-JCP", "CDP-DPP", "One opposition", 
    "30%", "40%", "50%", "60%", 
    "New issue", "Policy change", "Policy rejected", 
    "Leader change", "PM strength", "Gov't strength", "Full term", 
    "Surprised", 
    "0", "1 mo", "2 yrs", "3 yrs"))
```


Plot AMCEs and confidence intervals
```{r}
conjoint1_all_amce <- amce_all1d |> 
  filter(!is.na(estimate)) |> 
  ggplot() +
  geom_vline(xintercept = 0.0, linetype = "dashed") + 
  geom_pointrange(aes(x = estimate, y = level,
                      xmin = conf.low, xmax = conf.high), 
                  size = 0.4) +
  facet_grid(attribute ~ ., scales = "free", space = "free") + 
  labs(x = "Average marginal component effect and 95% confidence interval", 
       y = "Level") + 
  theme(strip.text.y = element_text(angle = 0))
plot(conjoint1_all_amce)
```

Save to PDF: Figure A2
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_A2.pdf",
          family = "sans", width = 8, height = 8)
print(conjoint1_all_amce)
dev.off()
```

Table A3
```{r}
#| eval: false
amce_all1d |> 
  select(attribute, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_A3.tex")
```



#### Survey 2

Make design matrix for cjoint's `amce`
```{r}
attribute_list2 <- list(
   remain = c("0", "0.5 yrs", "1 yr", "1.5 yrs",
              "2 yrs","2.5 yrs","3 yrs"),
    newspaper = c("expected", "surprised"),
    reason = c("leader change","no-confidence",
               "policy rejected","new issue",
               "policy change","PM strength",
               "gov't strength","full term"),
    popularity = c("20%", "30%", "40%", "50%", "60%"),
    opposition = c("many oppositions", "under negotiation", 
                   "CDP-JCP", "CDP-DPP", "one opposition"),
    growth = c("better", "same", "worse"),
    econ_policy = c("nothing", "stimulus", "counter unemployment"),
    how = c("PM alone", "PM backed by LDP", 
            "PM backed by LDP-Komei", "term expired"))

constraint_list2 <- list()
constraint_list2[[1]] <- list(
  remain = c("0"),
  reason = c("no-confidence",
             "new issue", 
             "policy change", 
             "policy rejected", 
             "leader change", 
             "PM strength", 
             "gov't strength"))
constraint_list2[[2]] <- list(
  remain = c("0"),
  how = c("PM alone", "PM backed by LDP", "PM backed by LDP-Komei")
)

design_obj2 <- makeDesign(
  type = "constraints",
  attribute.levels = attribute_list2,
  constraints = constraint_list2
)
```

Estimate AMCE by cjoint's `amce`
```{r}
amce_e2 <- amce(
  selected ~ remain + newspaper + reason + popularity + opposition + 
    growth + econ_policy + how,
  data = D2,
  cluster = TRUE,
  respondent.id = "ID",
  design = design_obj2,
  baseline = list(remain = "1 yr",
                  newspaper = "expected",
                  reason = "no-confidence",
                  popularity = "20%",
                  opposition = "many oppositions",
                  growth = "better",
                  econ_policy = "nothing",
                  how = "PM alone"))
plot(amce_e2)
```

Organize the results
```{r}
amce_all2 <- summary(amce_e2)$amce |> 
  select(Attribute, Level, Estimate, `Std. Err`) |> 
  rename(attribute = Attribute,
         level = Level,
         estimate = Estimate,
         se = `Std. Err`) |> 
  mutate(conf.low = estimate - 2 * se,
         conf.high = estimate + 2 * se)
```


Labeling
```{r}
attr2_amce <- tribble(
  ~attribute,    ~attr,
  "econ_policy", "Policy (Ref. Nothing)", 
  "growth",      "Economy (Ref. Better)", 
  "how",         "Decision (Ref. PM alone)",
  "newspaper",   "Newspaper Eval. (Ref. Expected)",
  "opposition",  "Opposition (Ref. Many oppositions)",
  "popularity",  "Cabinet Approval (Ref. 20%)",
  "reason",      "Reason (Ref. No confidence)",
  "remain",      "Remaining Term (Ref. 1 yr)")

level2_amce <- bind_rows(
  tibble(attribute = "econ_policy",
         level = c("stimulus", "counter unemployment"), 
         lev = c("Stimulus", "Counter unemployment")), 
  tibble(attribute = "growth",
         level = c("same", "worse"), 
         lev = c("Same", "Worse")), 
  tibble(attribute = "how", 
         level = c("PM backed by LDP", "PM backed by LDP-Komei", 
                 "term expired"), 
         lev = c("PM backed by LDP", "PM backed by LDP-Komei", 
                 "Term expired")), 
  tibble(attribute = "newspaper",
         level = "surprised",
         lev = c("Surprised")), 
  tibble(attribute = "opposition",
         level = c("under negotiation", "CDP-JCP", "CDP-DPP", 
                 "one opposition"), 
         lev = c("Under negotiation", "CDP-JCP", "CDP-DPP", 
                 "One opposition")), 
  tibble(attribute = "popularity", 
         level = c("30%","40%","50%","60%"), 
         lev = c("30%","40%","50%","60%")), 
  tibble(attribute = "reason", 
         level = c("policy rejected", 
                   "new issue", 
                   "policy change", 
                   "leader change",
                   "PM strength", 
                   "gov't strength",
                   "full term"),
         lev = c("Policy rejected", 
                 "New issue", 
                 "Policy change", 
                 "Leader change",
                 "PM strength", 
                 "Gov't strength",
                 "Full term")), 
  tibble(attribute = "remain",
         level =c("0", "0.5 yrs", "1.5 yrs",
                 "2 yrs", "2.5 yrs", "3 yrs"),
         lev = c("0", "0.5 yrs", "1.5 yrs",
                 "2 yrs", "2.5 yrs", "3 yrs")))
```


Set the lables and specify the order
```{r}
amce_all2b <- amce_all2 |> 
  left_join(attr2_amce, by = c("attribute"))

amce_all2c <- amce_all2b |> 
  left_join(level2_amce, by = c("attribute", "level")) |> 
  select(!c(attribute, level)) |> 
  rename(attribute = attr, level = lev)

amce_all2d <- amce_all2c |> 
  mutate(attribute = fct_relevel(
    .f = attribute,
    "Remaining Term (Ref. 1 yr)", "Newspaper Eval. (Ref. Expected)", 
    "Reason (Ref. No confidence)", "Cabinet Approval (Ref. 20%)",
    "Opposition (Ref. Many oppositions)", 
    "Economy (Ref. Better)", "Policy (Ref. Nothing)",
    "Decision (Ref. PM alone)"))

amce_all2d <- amce_all2d |> 
  mutate(level = fct_relevel(
    .f = level,
    "PM backed by LDP", "PM backed by LDP-Komei", "Term expired", 
    "Stimulus", "Counter unemployment", 
    "Same", "Worse", 
    "Under negotiation", "CDP-JCP", "CDP-DPP", "One opposition", 
    "30%", "40%", "50%", "60%", 
    "Policy rejected", "New issue", 
    "Policy change", "Leader change",
    "PM strength", "Gov't strength", "Full term", 
    "Surprised", 
    "0", "0.5 yrs", "1.5 yrs", "2 yrs", "2.5 yrs", "3 yrs"))

```


AMCEs and confidence intervals
```{r}
conjoint2_all_amce <- amce_all2d |>
  filter(!is.na(estimate)) |> 
  ggplot() +
  geom_vline(xintercept = 0.0, linetype = "dashed") + 
  geom_pointrange(aes(x = estimate, y = level, 
                       xmin = conf.low, xmax = conf.high), 
                  size = 0.4) +
  facet_grid(attribute ~ ., scales = "free", space = "free") + 
  labs(x = "Average marginal component effect and 95% confidence interval", 
       y = "Level") + 
  theme(strip.text.y = element_text(angle = 0))
plot(conjoint2_all_amce)
```

Save to PDF: Figure C1
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_C1.pdf",
          family = "sans", width = 8, height = 8)
print(conjoint2_all_amce)
dev.off()
```

Table C4
```{r}
#| eval: false
amce_all2d |> 
  select(attribute, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_C4.tex")
```


#### Knowledgeable voters

Estimate AMCE by cjoint's `amce`
```{r}
amce_e2k <- amce(
  selected ~ remain + newspaper + reason + popularity + opposition + 
    growth + econ_policy + how,
  data = Dk,
  cluster = TRUE,
  respondent.id = "ID",
  design = design_obj2,
  baseline = list(remain = "1 yr",
                  newspaper = "expected",
                  reason = "no-confidence",
                  popularity = "20%",
                  opposition = "many oppositions",
                  growth = "better",
                  econ_policy = "nothing",
                  how = "PM alone"))
plot(amce_e2k)
```

Organize the results
```{r}
amce_k <- summary(amce_e2k)$amce |> 
  select(Attribute, Level, Estimate, `Std. Err`) |> 
  rename(attribute = Attribute,
         level = Level,
         estimate = Estimate,
         se = `Std. Err`) |> 
  mutate(conf.low = estimate - 2 * se,
         conf.high = estimate + 2 * se)
```


Set the lables and specify the order
```{r}
amce_kb <- amce_k |> 
  left_join(attr2_amce, by = c("attribute"))

amce_kc <- amce_kb |> 
  left_join(level2_amce, by = c("attribute", "level")) |> 
  dplyr::select(-attribute, -level) |> 
  dplyr::rename(attribute = attr, level = lev)

amce_kd <- amce_kc |> 
  mutate(attribute = fct_relevel(.f = attribute,
    "Remaining Term (Ref. 1 yr)", "Newspaper Eval. (Ref. Expected)", 
    "Reason (Ref. No confidence)", "Cabinet Approval (Ref. 20%)",
    "Opposition (Ref. Many oppositions)", 
    "Economy (Ref. Better)", "Policy (Ref. Nothing)",
    "Decision (Ref. PM alone)"))

amce_kd <- amce_kd |> 
  mutate(level = fct_relevel(.f = level,
    "PM backed by LDP", "PM backed by LDP-Komei", "Term expired", 
    "Stimulus", "Counter unemployment", 
    "Same", "Worse", 
    "Under negotiation", "CDP-JCP", "CDP-DPP", "One opposition", 
    "30%", "40%", "50%", "60%", 
    "Policy rejected", "New issue", 
    "Policy change", "Leader change",
    "PM strength", "Gov't strength", "Full term", 
    "Surprised", 
    "0", "0.5 yrs", "1.5 yrs", "2 yrs", "2.5 yrs", "3 yrs"))

```


Plot AMCEs and confidence intervals
```{r}
conjoint2_k_amce <- amce_kd |>
  filter(!is.na(estimate)) |> 
  ggplot() +
  geom_vline(xintercept = 0.0, linetype = "dashed") + 
  geom_pointrange(aes(x = estimate, y = level, 
                       xmin = conf.low, xmax = conf.high),
                  size = 0.4) +
  facet_grid(attribute ~ ., scales = "free", space = "free") + 
  labs(x = "Average marginal component effect  and 95% confidence interval", 
       y = "Level") + 
  theme(strip.text.y = element_text(angle = 0))
plot(conjoint2_k_amce)
```

Save to PDF: Figure B2
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_B2.pdf",
          family = "sans", width = 8, height = 8)
print(conjoint2_k_amce)
dev.off()
```
Table B2
```{r}
#| eval: false
amce_kd |> 
  select(attribute, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_B2.tex")
```



## Partisan differences?

### PID

#### Survey 1

Create individual-level data and plot the distribution of PID
```{r}
D1_ind <- D1 |>  
  select(party, ID) |>  
  distinct() |>  
  mutate(
    party = factor(party, 
                   levels = c(1:7, 88, 99), 
                   labels = c("LDP", "CDP", "DPP", "Komeito", "JCP", 
                              "Ishin", "Other", "Non-partisan", "DK/NA")),
    party2 = fct_relevel(.f = party,
                         "LDP",  "Komeito", "Non-partisan",
                         "CDP", "DPP", "JCP", 
                         "Ishin", "Other",  "DK/NA"),
    party_color = case_when(
      party2 %in% c("LDP", "Komeito") ~ 1L,
      party2 == "Non-partisan" ~ 2L,
      party2 == "DK/NA" ~ 4L,
      TRUE ~ 3L))

s1_partisanship <- ggplot(D1_ind, aes(x = party2)) +
  geom_bar(aes(fill = as.factor(party_color))) +
  scale_fill_manual(name = "",
                    values =  c("darkorange","purple", "cyan4", "gray20")) +
  labs(x = "Party ID", y = "Count") +
  theme(legend.position = "None")

plot(s1_partisanship)
```

Save to PDF: Figure A3 
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_A3.pdf",
          family = "sans", width = 6, height = 2.5)
print(s1_partisanship)
dev.off()
```


#### Survey 2

Create individual-level data and plot the distribution of PID
```{r}
D2_ind <- D2 |>  
  select(party, ID) |>  
  distinct() |>  
  mutate(party = factor(party,
                        levels = c(1:8, 11, 88, 99),
                        labels = c("LDP", "CDP", "DPP", "Komeito",
                                   "JCP", "Ishin", "Reiwa", "SDP",
                                   "Other", "Non-partisan",
                                   "DK/NA")),
          party2 = fct_relevel(.f = party,
                               "LDP",  "Komeito", "Non-partisan",
                               "CDP", "DPP", "JCP", 
                               "Ishin", "Reiwa", "SDP",
                               "Other",  "DK/NA"),
          party_color = case_when(
            party2 %in% c("LDP", "Komeito") ~ 1L,
            party2 == "Non-partisan" ~ 2L,
            party2 == "DK/NA" ~ 4L,
            TRUE ~ 3L))

s2_partisanship <- ggplot(D2_ind, aes(x = party2)) +
  geom_bar(aes(fill = as.factor(party_color))) +
  scale_fill_manual(name = "",
                    values =  c("darkorange","purple", "cyan4", "gray20")) +
  labs(x = "Party ID", y = "Count") + 
  theme(axis.text.x = element_text(angle = 45, 
                                   vjust = 1, 
                                   hjust = 1),
        legend.position = "None")

plot(s2_partisanship)
```

Save to PDF: Figure 2
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_2.pdf",
          family = "sans", width = 6, height = 2.5)
print(s2_partisanship)
dev.off()

png(file = "figs/Figure_2.png", res = 600,
    width = 6, height = 2.5, unit = "in")
print(s2_partisanship)
dev.off()
```


### Cabinet approval x Remaining term

#### Survey 1

Set attributes
```{r}
attr1_po <- c("remain", "reason", "econ_policy", "achievement", 
               "newspaper", "growth", "opposition")
```


Creating subsets of data by cabinet support and partisanship
```{r}
# Partisanship
gov_codes1 <- c(1, 4) 
opp_codes1 <- c(2, 3, 5, 6, 7)
ind_code1  <- 88

# List to contain subsets
subset_list_rtpo1 <- list()

# Make the list
for (po in c("20%", "30%", "40%", "50%", "60%")) {
  # Government
  subset_list_rtpo1[[paste0("pop", po, "_gov1")]] <- D1 |> 
    filter(popularity == po, party %in% gov_codes1)
  # Independent
  subset_list_rtpo1[[paste0("pop", po, "_indep1")]] <- D1 |> 
    filter(popularity == po, party == ind_code1)
  # Opposition
  subset_list_rtpo1[[paste0("pop", po, "_opp1")]] <- D1 |> 
    filter(popularity == po, party %in% opp_codes1)}

# remove "%"
names(subset_list_rtpo1) <- names(subset_list_rtpo1) |>
  gsub("%", "p1", x = _)
```


Estimate MMs by projoint
```{r}
#| message: false
meta_cols <- c("ID", "task", "profile", "selected")
pop_keys  <- c("20p1", "30p1", "40p1", "50p1", "60p1")
pid_keys  <- c("gov", "indep", "opp")

mm_from_name <- function(df_name, irr = 0.85, attr_vec = NULL) {
  df <- subset_list_rtpo1[[df_name]]
  if (is.null(df) || !is.data.frame(df) || nrow(df) == 0) return(NULL)

  attrs <- if (is.null(attr_vec)) setdiff(names(df), meta_cols) 
           else intersect(attr_vec, names(df))

  pj <- make_projoint_data(
    .dataframe      = df,
    .attribute_vars = attrs,
    .id_var         = "ID",
    .task_var       = "task",
    .profile_var    = "profile",
    .selected_var   = "selected")

  fit <- projoint(
    pj,
    .structure = "profile_level",
    .estimand  = "mm",
    .se_method = "analytical",
    .irr       = irr)

  out <- summary(fit) |> 
    filter(estimand == "mm_corrected") |> 
    separate_wider_delim(att_level_choose, ":", names = c("attribute","level")) |> 
    select(attribute, level, estimate, se, conf.low, conf.high)

  m <- str_match(df_name, "^pop(\\d+)p1_(gov|indep|opp)1$")
  if (!is.na(m[1,1])) {
    out <- out |> 
      mutate(
        po  = paste0(m[1,2], "%"),
        pid = recode(m[1,3], gov="Government", indep="Independent", opp="Opposition"),
        subset_name = df_name
      )
  } else {
    out <- out |> mutate(subset_name = df_name)
  }
  out
}

# Analyze subset 15
safe_mm <- safely(mm_from_name, otherwise = NULL, quiet = TRUE)

target_names <- as.vector(outer(pop_keys, pid_keys, 
                                function(p, g) paste0("pop", p, "_", g, "1")))

po_all1 <- map(target_names, ~ safe_mm(.x, 
                                       irr = IRR_D1,
                                       attr_vec = attr1_po)) |> 
  map("result") |> 
  list_rbind()
```

Labels
```{r}
lev_rt1 <- tibble(attr = "Remaining term", 
                  level = paste0("level", 1:5),
                  lev = c("3 yrs", "2 yrs", "1 yr", "1 mo", "0"))
```

Merge labels
```{r}
rtpo1 <- po_all1 |>
  filter(attribute == "att7")  |>
  left_join(lev_rt1, by = c("level")) |> 
  select(!c(attribute, level)) |> 
  rename(attribute = attr, level = lev)
```


Plot: effect of remaining terms conditional on cabinet support
```{r, fig.width = 10, fig.height = 4}
timing_pop_1 <- rtpo1 |> 
  ggplot() +
  geom_vline(xintercept = 0.5, linetype = "dashed") + 
  geom_pointrange(aes(y = level, 
                      x = estimate, 
                      color = pid, 
                      shape = pid,
                      xmin = conf.low,
                      xmax = conf.high),
                  position = position_dodge(width = -0.7),
                  size = 0.3) + 
  facet_wrap(~po, ncol = 5) + 
  scale_x_continuous(limits = c(-0.8, 1.57), 
                     breaks = seq(-0.7, 1.6, by = 0.3)) +
  scale_y_discrete(limits=c("0", "1 mo", "1 yr", "2 yrs", "3 yrs")) + 
  scale_color_manual(values = c("Government"  = "darkorange",
                                "Independent" = "purple",
                                "Opposition"  = "cyan4")) + 
  scale_shape_manual(values = c("Government" = 16,
                                "Independent" = 17,
                                "Opposition"  = 15)) +
  labs(subtitle = "Cabinet Approval",
       x = "Marginal mean and 95% confidence interval",
       y = "Remaining term",
       color = "",
       shape = "") +
  theme(legend.position = "bottom") + 
  theme(axis.text.x = element_text(angle = 45, 
                                   vjust = 1, 
                                   hjust = 1))
plot(timing_pop_1)
```

Save to PDF: Figure A4
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_A4.pdf",
          family = "sans", width = 8, height = 4)
print(timing_pop_1)
dev.off()
```

Table A4
```{r}
#| eval: false
rtpo1 |> 
  select(pid, po, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_A4.tex")
```



#### Survey 2

Set attributes
```{r}
attr2_po <- c("remain", "reason", "econ_policy", "how",
              "newspaper", "growth", "opposition")
```

Partisanship
```{r}
gov_codes2 <- c(1, 4)
opp_codes2 <- c(2, 3, 5, 6, 7, 8, 11)
ind_code2  <- 88            
```


Subset the data by cabinet approval and partisanship
```{r}
subset_list_rtpo2 <- list()
for (po in c("20%", "30%", "40%", "50%", "60%")) {
  subset_list_rtpo2[[paste0("pop", po, "_gov2")]]   <- D2 |> 
    filter(popularity == po, party %in% gov_codes2)
  subset_list_rtpo2[[paste0("pop", po, "_indep2")]] <- D2 |> 
    filter(popularity == po, party == ind_code2)
  subset_list_rtpo2[[paste0("pop", po, "_opp2")]]   <- D2 |> 
    filter(popularity == po, party %in% opp_codes2)}

names(subset_list_rtpo2) <- gsub("%", "p2", names(subset_list_rtpo2))
```

Estimate by projoint
```{r}
#| message: false
meta_cols <- c("ID", "task", "profile", "selected")
pop_keys  <- c("20p2", "30p2", "40p2", "50p2", "60p2")
pid_keys  <- c("gov", "indep", "opp")

mm_from_name2 <- function(df_name, irr = 0.85, attr_vec = NULL) {
  df <- subset_list_rtpo2[[df_name]]
  if (is.null(df) || !is.data.frame(df) || nrow(df) == 0) return(NULL)

  attrs <- if (is.null(attr_vec)) setdiff(names(df), meta_cols)
           else intersect(attr_vec, names(df))

  pj <- make_projoint_data(
    .dataframe      = df,
    .attribute_vars = attrs,
    .id_var         = "ID",
    .task_var       = "task",
    .profile_var    = "profile",
    .selected_var   = "selected"
  )

  fit <- projoint(
    pj,
    .structure = "profile_level",
    .estimand  = "mm",
    .se_method = "analytical",
    .irr       = irr
  )

  out <- summary(fit) |>
    filter(estimand == "mm_corrected") |>
    separate_wider_delim(att_level_choose, ":", names = c("attribute","level")) |>
    select(attribute, level, estimate, se, conf.low, conf.high)

  m <- str_match(df_name, "^pop(\\d+)p2_(gov|indep|opp)2$")
  if (!is.na(m[1,1])) {
    out <- out |>
      mutate(
        po  = paste0(m[1,2], "%"),
        pid = recode(m[1,3],
                     gov   = "Government",
                     indep = "Independent",
                     opp   = "Opposition"),
        subset_name = df_name
      )
  } else {
    out <- out |> mutate(subset_name = df_name)
  }
  out
}

safe_mm2 <- safely(mm_from_name2, otherwise = NULL, quiet = TRUE)

target_names2 <- as.vector(outer(pop_keys, pid_keys,
                                 function(p, g) paste0("pop", p, "_", g, "2")))

po_all2 <- map(target_names2, ~ safe_mm2(.x, 
                                         irr = IRR_D2,
                                         attr_vec = attr2_po)) |>
  map("result") |>
  list_rbind()
```

Labels
```{r}
lev_rt2 <- tibble(attr = "Remaining term", 
                  level = paste0("level", 1:7),
                  lev = c("0", "0.5 yrs", "1 yr", "1.5 yrs",
                          "2 yrs", "2.5 yrs", "3 yrs"))
```


Merge labels
```{r}
rtpo2 <- po_all2 |>
  filter(attribute == "att7")  |>
  left_join(lev_rt2, by = c("level")) |> 
  select(!c(attribute, level)) |> 
  rename(attribute = attr, level = lev)
```

Plot the result
```{r}
#| fig-width: 6
timing_pop_2 <- rtpo2 |>
  ggplot() +
  geom_vline(xintercept = 0.5, linetype = "dashed") +
  geom_pointrange(aes(y = level, x = estimate, 
                      color = pid, shape = pid, 
                      xmin = conf.low, xmax = conf.high),
                  position = position_dodge(width = -0.7),
                  size = 0.3) + 
  facet_wrap(~po, ncol = 5) +
  scale_x_continuous(limits = c(0.2, 1), 
                     breaks = seq(0.2, 1, by = 0.2))+
  scale_color_manual(values = c("Government"  = "darkorange",
                                "Independent" = "purple",
                                "Opposition"  = "cyan4")) + 
  scale_shape_manual(values = c("Government" = 16,
                                "Independent" = 17,
                                "Opposition"  = 15)) +
  labs(subtitle = "Cabinet Approval",
       x = "Marginal mean and 95% confidence interval",
       y = "Remaining Term",
       color = "",
       shape = "") +
  theme(legend.position = "bottom") + 
  theme(axis.text.x = element_text(angle = 45, 
                                   vjust = 1, 
                                   hjust = 1))

plot(timing_pop_2)
```

Save to PDF: Figure 3
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_3.pdf",
          family = "sans", width = 8, height = 4)
print(timing_pop_2)
dev.off()
png(file = "figs/Figure_3.png", res = 600,
    width = 8, height = 4, unit = "in")
print(timing_pop_2)
dev.off()
```

Table C5
```{r}
#| eval: false
rtpo2 |> 
  select(pid, po, level, estimate, se, conf.low, conf.high) |> 
  arrange(po, pid, desc(level)) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_C5.tex")
```


#### Knowledgeable voters

Subset the data
```{r}
subset_list_rtpo3 <- list()
for (po in c("20%", "30%", "40%", "50%", "60%")) {
  subset_list_rtpo3[[paste0("pop", po, "_gov3")]]   <- Dk |>
    filter(popularity == po, party %in% gov_codes2)
  subset_list_rtpo3[[paste0("pop", po, "_indep3")]] <- Dk |>
    filter(popularity == po, party == ind_code2)
  subset_list_rtpo3[[paste0("pop", po, "_opp3")]]   <- Dk |>
    filter(popularity == po, party %in% opp_codes2)
}

names(subset_list_rtpo3) <- gsub("%", "p3", names(subset_list_rtpo3))
```


Estimate by projoint
```{r}
#| message: false
meta_cols <- c("ID","task","profile","selected")
pop_keys3 <- c("20p3","30p3","40p3","50p3","60p3")
pid_keys3 <- c("gov","indep","opp")

mm_from_name3 <- function(df_name, irr = 0.85, attr_vec = NULL) {
  df <- subset_list_rtpo3[[df_name]]
  if (is.null(df) || !is.data.frame(df) || nrow(df) == 0) return(NULL)

  attrs <- if (is.null(attr_vec)) setdiff(names(df), meta_cols)
           else intersect(attr_vec, names(df))

  pj <- make_projoint_data(
    .dataframe      = df,
    .attribute_vars = attrs,
    .id_var         = "ID",
    .task_var       = "task",
    .profile_var    = "profile",
    .selected_var   = "selected"
  )

  fit <- projoint(
    pj,
    .structure = "profile_level",
    .estimand  = "mm",
    .se_method = "analytical",
    .irr       = irr
  )

  out <- summary(fit) |>
    filter(estimand == "mm_corrected") |>
    separate_wider_delim(att_level_choose, ":", names = c("attribute","level")) |>
    select(attribute, level, estimate, se, conf.low, conf.high)

  m <- str_match(df_name, "^pop(\\d+)p3_(gov|indep|opp)3$")
  if (!is.na(m[1,1])) {
    out <- out |>
      mutate(
        po  = paste0(m[1,2], "%"),
        pid = recode(m[1,3],
                     gov   = "Government",
                     indep = "Independent",
                     opp   = "Opposition"),
        subset_name = df_name
      )
  } else {
    out <- out |> mutate(subset_name = df_name)
  }
  out
}

safe_mm3 <- safely(mm_from_name3, otherwise = NULL, quiet = TRUE)

target_names3 <- as.vector(outer(pop_keys3, pid_keys3,
                                 function(p, g) paste0("pop", p, "_", g, "3")))

po_all3 <- map(target_names3,
               ~ safe_mm3(.x, 
                          irr = IRR_Dk,
                          attr_vec = attr2_po)) |>
  map("result") |>
  list_rbind()
```

Merge labels
```{r}
rtpo3 <- po_all3 |>
  filter(attribute == "att7")  |>
  left_join(lev_rt2, by = c("level")) |> 
  select(!c(attribute, level)) |> 
  rename(attribute = attr, level = lev)
```

Plot the result
```{r}
#| fig-width: 6
timing_pop_know <- rtpo3 |>
  ggplot() +
  geom_vline(xintercept = 0.5, linetype = "dashed") +
  geom_pointrange(
    aes(y = level, x = estimate, color = pid, shape = pid, 
        xmin = conf.low, xmax = conf.high),
    position = position_dodge(width = -0.7),
                  size = 0.3) + 
  facet_wrap(~po, ncol = 5) +
  scale_x_continuous(limits = c(0, 1.1), 
                     breaks = seq(0, 1, by = 0.25)) +
  scale_color_manual(values = c("Government"  = "darkorange",
                                "Independent" = "purple",
                                "Opposition"  = "cyan4")) + 
  scale_shape_manual(values = c("Government" = 16,
                                "Independent" = 17,
                                "Opposition"  = 15)) +
  labs(subtitle = "Cabinet Approval",
       x = "Marginal mean and 95% confidence interval",
       y = "Remaining Term",
       color = "",
       shape = "") +
  theme(legend.position = "bottom") + 
  theme(axis.text.x = element_text(angle = 45, 
                                   vjust = 1, 
                                   hjust = 1))

plot(timing_pop_know)
```

Save to PDF: Figure B3
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_B3.pdf",
          family = "sans", width = 8, height = 4)
print(timing_pop_know)
dev.off()
```

Table B3
```{r}
#| eval: false
rtpo3 |> 
  select(pid, po, level, estimate, se, conf.low, conf.high) |> 
  arrange(po, pid, desc(level)) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_B3.tex")
```



### Opposition coordination x Remaining term

#### Survey 1

Set attributes
```{r}
attr1_op <- c("remain", "reason", "econ_policy", "achievement", 
               "popularity", "newspaper", "growth")
```


Subset the data
```{r}
subset_list_rtop1 <- list()

op_levels1 <- c("one opposition", "under negotiation", "many oppositions")

key_map1 <- c("one opposition" = "oo1", 
              "under negotiation" = "un1", 
              "many oppositions" = "ma1")

for (op in op_levels1) {
  key <- key_map1[[op]]

  subset_list_rtop1[[paste0("opp", key, "_gov1")]] <- D1 |> 
    filter(opposition == op, party %in% gov_codes1)

  subset_list_rtop1[[paste0("opp", key, "_indep1")]] <-D1 |> 
    filter(opposition == op, party == ind_code1)

  subset_list_rtop1[[paste0("opp", key, "_opp1")]] <- D1 |> 
    filter(opposition == op, party %in% opp_codes1)}

```


Estimate by projoint
```{r}
#| message: false
meta_cols <- c("ID", "task", "profile", "selected")

op_keys  <- c("oo1", "un1", "ma1") 
pid_keys <- c("gov", "indep", "opp")


mm_from_name_opp1 <- function(df_name, irr = 0.85, attr_vec = NULL) {
  df <- subset_list_rtop1[[df_name]]
  if (is.null(df) || !is.data.frame(df) || nrow(df) == 0) return(NULL)

  attrs <- if (is.null(attr_vec)) setdiff(names(df), meta_cols) 
           else intersect(attr_vec, names(df))

  pj <- make_projoint_data(
    .dataframe      = df,
    .attribute_vars = attrs,
    .id_var         = "ID",
    .task_var       = "task",
    .profile_var    = "profile",
    .selected_var   = "selected" )

  fit <- projoint(
    pj,
    .structure = "profile_level",
    .estimand  = "mm",
    .se_method = "analytical",
    .irr       = irr)

  out <- summary(fit) |>
    filter(estimand == "mm_corrected") |>
    separate_wider_delim(att_level_choose, ":", 
                         names = c("attribute", "level")) |>
    select(attribute, level, estimate, se, conf.low, conf.high)

  m <- str_match(df_name, "^opp(oo|un|ma)1_(gov|indep|opp)1$")
  if (!is.na(m[1,1])) {
    op_map  <- c(oo = "One Opposition", un = "Under Negotiation", ma = "Many Oppositions")
    pid_map <- c(gov = "Government",    indep = "Independent",    opp = "Opposition")

    out <- out |>
      mutate(
        op   = op_map[m[1,2]],
        pid  = pid_map[m[1,3]],
        subset_name = df_name
      )
  } else {
    out <- out |> mutate(subset_name = df_name)
  }
  out}

safe_mm_opp1 <- safely(mm_from_name_opp1, otherwise = NULL, quiet = TRUE)

target_names_opp1 <- as.vector(
  outer(op_keys, pid_keys, function(opk, pid) paste0("opp", opk, "_", pid, "1")))

op_all1 <- map(target_names_opp1, ~ safe_mm_opp1(.x, 
                                                 irr = IRR_D1,
                                                attr_vec = attr1_po)) |>
  map("result") |>
  list_rbind()
```


Merge labels
```{r}
rtop1 <- op_all1 |>
  filter(attribute == "att7")  |>
  left_join(lev_rt1, by = c("level")) |> 
  select(!c(attribute, level)) |> 
  rename(attribute = attr, level = lev)
```


Order levels of coordination status
```{r}
rtop1$op <- factor(rtop1$op,levels = c("One Opposition", 
                                       "Under Negotiation", 
                                       "Many Oppositions"))
```


Plot: The effect of remaining term conditional on opposition coordination
```{r}
#| fig-width: 6
timing_coordination_1 <- rtop1 |> 
  ggplot() +
  geom_vline(xintercept = 0.5, linetype = "dashed") + 
  geom_pointrange(aes(y = level, x = estimate, 
                      color = pid, shape = pid,
                      xmin = conf.low, xmax = conf.high),
                  position = position_dodge(width = -0.7),
                  size = 0.3) + 
  facet_wrap(~op, ncol=3) + 
  scale_x_continuous(limits = c(-0.2, 1.65), 
                     breaks = seq(-0.1, 1.8, by = 0.2)) + 
  scale_y_discrete(limits=c("0", "1 mo", "1 yr", "2 yrs", "3 yrs")) + 
  scale_color_manual(values = c("Government"  = "darkorange",
                                "Independent" = "purple",
                                "Opposition"  = "cyan4")) + 
  scale_shape_manual(values = c("Government" = 16,
                                "Independent" = 17,
                                "Opposition"  = 15)) +
  labs(subtitle = "Opposition Coordination",
       y = 'Remaining term', 
       x = 'Marginal mean and 95% confidence interval',
       color = "",
       shape = "") +
  theme(legend.position = "bottom")

plot(timing_coordination_1)
```

Save to PDF: Figure A5
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_A5.pdf",
          family = "sans", width = 8, height = 4)
print(timing_coordination_1)
dev.off()
```

Table A5
```{r}
#| eval: false
rtop1 |> 
  select(pid, op, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_A5.tex")
```




#### Survey 2

Set attributes
```{r}
attr2_op <- c("remain", "reason", "econ_policy", "how",
              "popularity", "newspaper", "growth")
```


Subset the data
```{r}
subset_list_rtop2 <- list()

op_levels2 <- c("one opposition", "under negotiation", "many oppositions")

key_map2 <- c("one opposition" = "oo2",
              "under negotiation" = "un2",
              "many oppositions" = "ma2")

for (op in op_levels2) {
  key <- key_map2[[op]]

  subset_list_rtop2[[paste0("opp", key, "_gov2")]] <- D2 |>
    filter(opposition == op, party %in% gov_codes2)

  subset_list_rtop2[[paste0("opp", key, "_indep2")]] <- D2 |>
    filter(opposition == op, party == ind_code2)

  subset_list_rtop2[[paste0("opp", key, "_opp2")]] <- D2 |>
    filter(opposition == op, party %in% opp_codes2)}
```


Estimate by projoint
```{r}
#| message: false
meta_cols <- c("ID", "task", "profile", "selected")

op_keys2  <- c("oo2","un2","ma2")
pid_keys2 <- c("gov","indep","opp")

mm_from_name_opp2 <- function(df_name, irr = 0.85, attr_vec = NULL) {
  df <- subset_list_rtop2[[df_name]]
  if (is.null(df) || !is.data.frame(df) || nrow(df) == 0) return(NULL)

  attrs <- if (is.null(attr_vec)) setdiff(names(df), meta_cols)
           else intersect(attr_vec, names(df))

  pj <- make_projoint_data(
    .dataframe      = df,
    .attribute_vars = attrs,
    .id_var         = "ID",
    .task_var       = "task",
    .profile_var    = "profile",
    .selected_var   = "selected"
  )

  fit <- projoint(
    pj,
    .structure = "profile_level",
    .estimand  = "mm",
    .se_method = "analytical",
    .irr       = irr
  )

  out <- summary(fit) |>
    filter(estimand == "mm_corrected") |>
    separate_wider_delim(att_level_choose, ":", 
                         names = c("attribute","level")) |>
    select(attribute, level, estimate, se, conf.low, conf.high)

  m <- str_match(df_name, "^opp(oo|un|ma)2_(gov|indep|opp)2$")
  if (!is.na(m[1,1])) {
    op_map  <- c(oo = "One Opposition", un = "Under Negotiation", ma = "Many Oppositions")
    pid_map <- c(gov = "Government",    indep = "Independent",    opp = "Opposition")

    out <- out |>
      mutate(
        op   = op_map[m[1,2]],
        pid  = pid_map[m[1,3]],
        subset_name = df_name
      )
  } else {
    out <- out |> mutate(subset_name = df_name)
  }
  out
}

safe_mm_opp2 <- safely(mm_from_name_opp2, otherwise = NULL, quiet = TRUE)

target_names_opp2 <- as.vector(
  outer(op_keys2, pid_keys2, function(opk, pid) paste0("opp", opk, "_", pid, "2"))
)

op_all2 <- map(target_names_opp2, 
               ~ safe_mm_opp2(.x,                          
                              irr = IRR_D2,
                              attr_vec = attr2_op)) |>
  map("result") |>
  list_rbind()
```


Merge labels
```{r}
rtop2 <- op_all2 |>
  filter(attribute == "att7")  |>
  left_join(lev_rt2, by = c("level")) |> 
  select(!c(attribute, level)) |> 
  rename(attribute = attr, level = lev)
```

Order values in opporition coordination
```{r}
rtop2$op <- factor(rtop2$op,levels = c("One Opposition", 
                                       "Under Negotiation", 
                                       "Many Oppositions"))
```

Plot: effect of remaining term conditional on opposition coordination
```{r}
#| fig-width: 6
timing_coordination_2 <- rtop2 |> 
  ggplot() +
  geom_vline(xintercept = 0.5, linetype = "dashed") + 
  geom_pointrange(aes(y = level, x = estimate, color = pid, shape = pid,
                      xmin = conf.low, xmax = conf.high),
                  position = position_dodge(width = -0.7),
                  size = 0.3) + 
  facet_wrap(~op, ncol=3) + 
  scale_x_continuous(limits = c(0.2, 0.92), 
                     breaks = seq(0.2, 1, by = 0.1)) +
  scale_color_manual(values = c("Government"  = "darkorange",
                                "Independent" = "purple",
                                "Opposition"  = "cyan4")) + 
  scale_shape_manual(values = c("Government" = 16,
                                "Independent" = 17,
                                "Opposition"  = 15)) +
  labs(subtitle = "Opposition Coordination",
       y = 'Remaining term', 
       x = 'Marginal mean and 95% confidence interval',
       color = "",
       shape = "") +
  theme(legend.position = "bottom")

plot(timing_coordination_2)
```

Save to PDF: Figure 4
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_4.pdf",
          family = "sans", width = 8, height = 4)
print(timing_coordination_2)
dev.off()
png(file = "figs/Figure_4.png", res = 600,
    width = 8, height = 4, unit = "in")
print(timing_coordination_2)
dev.off()
```

Table C6
```{r}
#| eval: false
rtop2 |> 
  select(pid, op, level, estimate, se, conf.low, conf.high) |> 
  arrange(op, pid, desc(level)) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_C6.tex")
```


#### Knowledgeabl voters

Subset the data
```{r}
subset_list_rtop3 <- list()

op_levels3 <- c("one opposition", "under negotiation", "many oppositions")

key_map3 <- c("one opposition"="oo3",
              "under negotiation"="un3",
              "many oppositions"="ma3")

for (op in op_levels3) {
  key <- key_map3[[op]]


  subset_list_rtop3[[paste0("opp", key, "_gov3")]] <- Dk |>
    dplyr::filter(opposition == op, party %in% gov_codes2)


  subset_list_rtop3[[paste0("opp", key, "_indep3")]] <- Dk |>
    dplyr::filter(opposition == op, party == ind_code2)


  subset_list_rtop3[[paste0("opp", key, "_opp3")]] <- Dk |>
    dplyr::filter(opposition == op, party %in% opp_codes2)}

```


Estimate by projoint
```{r}
#| message: false
meta_cols <- c("ID","task","profile","selected")

op_keys3  <- c("oo3","un3","ma3")
pid_keys3 <- c("gov","indep","opp")

mm_from_name_opp3 <- function(df_name, irr = 0.85, attr_vec = NULL) {
  df <- subset_list_rtop3[[df_name]]
  if (is.null(df) || !is.data.frame(df) || nrow(df) == 0) return(NULL)

  attrs <- if (is.null(attr_vec)) setdiff(names(df), meta_cols)
           else intersect(attr_vec, names(df))

  pj <- make_projoint_data(
    .dataframe      = df,
    .attribute_vars = attrs,
    .id_var         = "ID",
    .task_var       = "task",
    .profile_var    = "profile",
    .selected_var   = "selected"
  )

  fit <- projoint(
    pj,
    .structure = "profile_level",
    .estimand  = "mm",
    .se_method = "analytical",
    .irr       = irr
  )

  out <- summary(fit) |>
    filter(estimand == "mm_corrected") |>
    separate_wider_delim(att_level_choose, ":",
                         names = c("attribute","level")) |>
    select(attribute, level, estimate, se, conf.low, conf.high)

  m <- str_match(df_name, "^opp(oo|un|ma)3_(gov|indep|opp)3$")
  if (!is.na(m[1,1])) {
    op_map  <- c(oo = "One Opposition", un = "Under Negotiation", ma = "Many Oppositions")
    pid_map <- c(gov = "Government",    indep = "Independent",    opp = "Opposition")

    out <- out |>
      mutate(
        op   = op_map[m[1,2]],
        pid  = pid_map[m[1,3]],
        subset_name = df_name
      )
  } else {
    out <- out |> mutate(subset_name = df_name)
  }
  out
}

safe_mm_opp3 <- safely(mm_from_name_opp3, otherwise = NULL, quiet = TRUE)

target_names_opp3 <- as.vector(
  outer(op_keys3, pid_keys3, function(opk, pid) paste0("opp", opk, "_", pid, "3"))
)

op_all3 <- map(target_names_opp3,
               ~ safe_mm_opp3(.x,
                              irr = IRR_Dk,
                              attr_vec = attr2_op)) |>
  map("result") |>
  list_rbind()
```


Merge labels
```{r}
rtop3 <- op_all3 |>
  filter(attribute == "att7")  |>
  left_join(lev_rt2, by = c("level")) |> 
  select(!c(attribute, level)) |> 
  rename(attribute = attr, level = lev)
```

Order opposition var
```{r}
rtop3$op <- factor(rtop3$op,levels = c("One Opposition", 
                                       "Under Negotiation", 
                                       "Many Oppositions"))
```

Plot: effect of remaining term conditional on opposition coordination
```{r}
#| fig-width: 6
timing_coordination_know <- rtop3 |> 
  ggplot() +
  geom_vline(xintercept = 0.5, linetype = "dashed") + 
  geom_pointrange(aes(y = level, x = estimate,
                      color = pid, shape = pid,
                      xmin = conf.low, xmax = conf.high),
                  position = position_dodge(width = -0.7),
                  size = 0.3) + 
  facet_wrap(~op, ncol=3) + 
  scale_x_continuous(limits = c(0.1, 1), 
                     breaks = seq(0, 1, by = 0.25)) +
  scale_color_manual(values = c("Government"  = "darkorange",
                                "Independent" = "purple",
                                "Opposition"  = "cyan4")) + 
  scale_shape_manual(values = c("Government" = 16,
                                "Independent" = 17,
                                "Opposition"  = 15)) +
  labs(subtitle = "Opposition Coordination",
       y = 'Remaining term', 
       x = 'Marginal mean and 95% confidence interval',
       color = "",
       shape = "") +
  theme(legend.position = "bottom")

plot(timing_coordination_know)
```

Save to PDF: Figure B4
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_B4.pdf",
          family = "sans", width = 8, height = 4)
print(timing_coordination_know)
dev.off()
```

Table B4
```{r}
#| eval: false
rtop3 |> 
  select(pid, op, level, estimate, se, conf.low, conf.high) |> 
  arrange(op, pid, desc(level)) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_B4.tex")
```




### Gov Support x Newspaper eval.

#### Survey 1

Label
```{r}
lev_np <-  tibble(attr = "Newspaper's evaluation", 
                  level = paste0("level", 1:2),
                  lev = c("Expected", "Surprised"))
```

Merge labels
```{r}
nppo1 <- po_all1 |>
  filter(attribute == "att4")  |>
  left_join(lev_np, by = c("level")) |> 
  select(!c(attribute, level)) |> 
  rename(attribute = attr, level = lev)
```

Plot: Effect of remaining term conditional on cabinet support
```{r}
#| fig-width: 6
np_pop_1 <- nppo1 |> 
  ggplot() +
  geom_vline(xintercept = 0.5, linetype = "dashed") + 
  geom_pointrange(aes(y = level, x = estimate,
                      color = pid, shape = pid,
                      xmin = conf.low, xmax = conf.high),
                  position = position_dodge(width = -0.7),
                  size = 0.3) + 
  facet_wrap(~po, ncol = 5) + 
  scale_x_continuous(limits = c(0.25, 0.7), 
                     breaks = seq(0.2, 0.7, by = 0.1)) +
  scale_color_manual(values = c("Government"  = "darkorange",
                                "Independent" = "purple",
                                "Opposition"  = "cyan4")) + 
  scale_shape_manual(values = c("Government" = 16,
                                "Independent" = 17,
                                "Opposition"  = 15)) +
  labs(subtitle = "Cabinet Approval",
       x = "Marginal mean and 95% confidence interval",
       y = "Newspaper's evaluation",
       color = "",
       shape = "") +
  theme(legend.position = "bottom")

plot(np_pop_1)
```

Save to PDF: Figure A6
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_A6.pdf",
          family = "sans", width = 8, height = 3)
print(np_pop_1)
dev.off()
```

Table A6
```{r}
#| eval: false
nppo1 |> 
  select(pid, po, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_A6.tex")
```


#### Survey 2

Merge labels
```{r}
nppo2 <- po_all2 |>
  filter(attribute == "att4")  |>
  left_join(lev_np, by=c("level")) |> 
  select(!c(attribute, level)) |> 
  rename(attribute = attr, level = lev)
```

Plot: effect of remaining term conditional on cabinet support
```{r}
#| fig-width: 6
np_pop_2 <- nppo2 |> 
  ggplot() +
  geom_vline(xintercept = 0.5, linetype = "dashed") + 
  geom_pointrange(aes(y = level, x = estimate, 
                      color = pid, shape = pid,
                      xmin = conf.low, xmax = conf.high),
                  position = position_dodge(width = -0.7),
                  size = 0.3) + 
  facet_wrap(~po, ncol=5) + 
  scale_x_continuous(limits = c(0.3, 0.65), 
                     breaks=c(0.3, 0.4, 0.5, 0.6)) +
  scale_color_manual(values = c("Government"  = "darkorange",
                                "Independent" = "purple",
                                "Opposition"  = "cyan4")) + 
  scale_shape_manual(values = c("Government" = 16,
                                "Independent" = 17,
                                "Opposition"  = 15)) +
  labs(subtitle = "Cabinet Approval",
       x = "Marginal mean and 95% confidence interval",
       y = "Newspaper's evaluation",
       color = "",
       shape = "") +
  theme(legend.position = "bottom")

plot(np_pop_2)
```

Save to PDF: Figure C2
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_C2.pdf",
          family = "sans", width = 8, height = 3)
print(np_pop_2)
dev.off()
```

Table C7
```{r}
#| eval: false
nppo2 |> 
  select(pid, po, level, estimate, se, conf.low, conf.high) |> 
  arrange(po, pid, level) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_C7.tex")
```




#### Knowledgeable voters

Merge labels
```{r}
nppo3 <- po_all3 |>
  filter(attribute == "att4")  |>
  left_join(lev_np, by=c("level")) |> 
  select(!c(attribute, level)) |> 
  rename(attribute = attr, level = lev)
```

Plot: effect conditional on opposition coordination
```{r}
#| fig-width: 6
np_pop_know <- nppo3 |> 
  ggplot() +
  geom_vline(xintercept = 0.5, linetype = "dashed") + 
  geom_pointrange(aes(y = level, x = estimate, color = pid, shape = pid,
                      xmin = conf.low, xmax = conf.high),
                  position = position_dodge(width = -0.7),
                  size = 0.3) + 
  facet_wrap(~po, ncol=5) + 
  scale_x_continuous(limits = c(0.2, 0.8), 
                     breaks = seq(0.2, 0.8, by = 0.2)) +
  scale_color_manual(values =c("Government"  = "darkorange",
                                "Independent" = "purple",
                                "Opposition"  = "cyan4")) + 
  scale_shape_manual(values = c("Government" = 16,
                                "Independent" = 17,
                                "Opposition"  = 15)) +
  labs(subtitle = "Cabinet Approval",
       x = "Marginal mean and 95% confidence interval",
       y = "Newspaper's evaluation",
       color = "",
       shape = "") +
  theme(legend.position = "bottom")

plot(np_pop_know)
```

Save to PDF: Figure B5
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_B5.pdf",
          family = "sans", width = 8, height = 3)
print(np_pop_know)
dev.off()
```

Table B5
```{r}
#| eval: false
nppo3 |> 
  select(pid, po, level, estimate, se, conf.low, conf.high) |> 
  arrange(po, pid, level) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_B5.tex")
```



### Opposition x Newspaper

#### Survey 1

Merge labels
```{r}
npop1 <- op_all1 |>
  filter(attribute == "att4")  |>
  left_join(lev_np, by =c("level")) |> 
  select(!c(attribute, level)) |> 
  rename(attribute = attr, level = lev)
```


Order the variable
```{r}
npop1$op <- factor(npop1$op,levels = c("One Opposition", 
                                       "Under Negotiation", 
                                       "Many Oppositions"))
```


Plot: effect of remaining term conditional on opposition coordination
```{r}
#| fig-width: 6
np_coordination_1 <- npop1 |> 
  ggplot() +
  geom_vline(xintercept = 0.5, linetype = "dashed") + 
  geom_pointrange(aes(y = level, x = estimate, 
                      color = pid, shape = pid,
                      xmin = conf.low, xmax = conf.high),
                  position = position_dodge(width = -0.7),
                  size = 0.3) + 
  facet_wrap(~op, ncol = 3) + 
  scale_x_continuous(limits = c(0.2, 0.75), 
                     breaks = seq(0.2, 0.8, by = 0.1)) +
  scale_color_manual(values = c("Government"  = "darkorange",
                                "Independent" = "purple",
                                "Opposition"  = "cyan4")) + 
  scale_shape_manual(values = c("Government" = 16,
                                "Independent" = 17,
                                "Opposition"  = 15)) +
  labs(subtitle = "Opposition Coordination",
       x = "Marginal mean and 95% confidence interval",
       y = "Newspaper's evaluation",
       color = "",
       shape = "") +
  theme(legend.position = "bottom")

plot(np_coordination_1)
```

Save to PDF: Figure A7
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_A7.pdf",
          family = "sans", width = 8, height = 3)
print(np_coordination_1)
dev.off()
```

Table A7
```{r}
#| eval: false
npop1 |> 
  select(pid, op, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_A7.tex")
```


#### Survey 2

Merge labels
```{r}
npop2 <- op_all2 |>
  filter(attribute == "att4")  |>
  left_join(lev_np, by = c("level")) |> 
  select(!c(attribute, level)) |> 
  rename(attribute = attr, level = lev)
```


Order coordination var
```{r}
npop2$op <- factor(npop2$op,
                   levels = c("One Opposition",
                              "Under Negotiation",
                              "Many Oppositions"))
```

Plot: effect of remaining term conditional on opposition coordination
```{r, fig.width = 10, fig.height = 4}
np_coordination_2 <- npop2 |> 
  ggplot() +
  geom_vline(xintercept = 0.5, linetype = "dashed") + 
  geom_pointrange(aes(y = level, x = estimate, 
                      color = pid, shape = pid,
                      xmin = conf.low, xmax = conf.high),
                  position = position_dodge(width = -0.7),
                  size = 0.3) + 
  facet_wrap(~op, ncol = 3) + 
  scale_x_continuous(limits = c(0.3, 0.72), 
                     breaks = seq(0.3, 0.7, by = 0.1)) +
  scale_color_manual(values = c("Government"  = "darkorange",
                                "Independent" = "purple",
                                "Opposition"  = "cyan4")) +
  scale_shape_manual(values = c("Government" = 16,
                                "Independent" = 17,
                                "Opposition"  = 15)) +
  labs(subtitle = "Opposition Coordination",
       x = "Marginal mean and 95% confidence interval",
       y = "Newspaper's evaluation",
       color = "",
       shape = "") +
  theme(legend.position = "bottom")

plot(np_coordination_2)
```


Save to PDF: Figure C3
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_C3.pdf",
          family = "sans", width = 8, height = 3)
print(np_coordination_2)
dev.off()
```

Table C8
```{r}
#| eval: false
npop2 |> 
  select(pid, op, level, estimate, se, conf.low, conf.high) |> 
  arrange(op, pid, level) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_C8.tex")
```


#### Knowledgeable voters

Merge labels
```{r}
npop3 <- op_all3 |>
  filter(attribute == "att4")  |>
  left_join(lev_np, by=c("level")) |> 
  select(!c(attribute, level)) |> 
  rename(attribute = attr, level = lev)
```


Order cooridination var
```{r}
npop3$op <- factor(npop3$op,levels = c("One Opposition", 
                                       "Under Negotiation", 
                                       "Many Oppositions"))
```


Plot: effect conditional on coordination 
```{r}
#| fig-width: 6
np_coordination_know <- npop3 |> 
  ggplot() +
  geom_vline(xintercept = 0.5, linetype = "dashed") + 
  geom_pointrange(aes(y = level, x = estimate,
                      color = pid, shape = pid,
                      xmin = conf.low, xmax = conf.high),
                  position = position_dodge(width = -0.7),
                  size = 0.3) + 
  facet_wrap(~op, ncol = 3) + 
  scale_x_continuous(limits = c(0.2, 0.8), 
                     breaks = seq(0.2, 0.8, by = 0.1)) +
  scale_color_manual(values = c("Government"  = "darkorange",
                                "Independent" = "purple",
                                "Opposition"  = "cyan4")) + 
  scale_shape_manual(values = c("Government" = 16,
                                "Independent" = 17,
                                "Opposition"  = 15)) +
  labs(subtitle = "Opposition Coordination",
       x = "Marginal mean and 95% confidence interval",
       y = "Newspaper's evaluation",
       color = "",
       shape = "") +
  theme(legend.position = "bottom")

plot(np_coordination_know)
```


Save to PDF: Figure B6
```{r}
#| eval: false
cairo_pdf(file = "figs/Figure_B6.pdf",
          family = "sans", width = 8, height = 3)
print(np_coordination_know)
dev.off()
```

Table B6
```{r}
#| eval: false
npop3 |> 
  select(pid, op, level, estimate, se, conf.low, conf.high) |> 
  arrange(op, pid, level) |> 
  kbl(digits = 3,
      format = "latex",
      booktabs = TRUE) |> 
  writeLines("tabs/Table_B6.tex")
```



## Tables and Figures

### Main

Figure 1
```{r}
plot(conjoint2_all)
```

Figure 2
```{r}
#| fig-width: 6
plot(s2_partisanship)
```

Figure 3
```{r}
#| fig-width: 6
plot(timing_pop_2)
```

Save to PDF: Figure 4
```{r}
#| fig-width: 6
plot(timing_coordination_2)
```




### Appendix A

Figure A1
```{r}

plot(conjoint1_all)
```

Table A2
```{r}
mm_all1d |> 
  select(attribute, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "html")
```


Figure A2
```{r}
plot(conjoint1_all_amce)
```

Table A3
```{r}
#| eval: false
amce_all1d |> 
  select(attribute, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "html")
```


Save to PDF: Figure A3 
```{r}
#| fig-width: 6
plot(s1_partisanship)
```


Figure A4
```{r}
#| fig-width: 6
plot(timing_pop_1)
```

Table A4
```{r}
rtpo1 |> 
  select(pid, po, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "html")
```


Figure A5
```{r}
#| fig-width: 6
plot(timing_coordination_1)
```

Table A5
```{r}
rtop1 |> 
  select(pid, op, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "html")
```


Figure A6
```{r}
#| fig-width: 6
plot(np_pop_1)
```

Table A6
```{r}
nppo1 |> 
  select(pid, po, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "html")
```


Save to PDF: Figure A7
```{r}
#| fig-width: 6
plot(np_coordination_1)
```

Table A7
```{r}
npop1 |> 
  select(pid, op, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "html")
```



### Appendix B


Save to PDF: Figure B1
```{r}
plot(conjoint2_know)
```

Table B1
```{r}
mm_all3d |> 
  select(attribute, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "html")
```

Figure B2
```{r}
plot(conjoint2_k_amce)
```

Table B2
```{r}
amce_kd |> 
  select(attribute, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "html")
```


Figure B3
```{r}
#| fig-width: 6
plot(timing_pop_know)
```

Table B3
```{r}
rtpo3 |> 
  select(pid, po, level, estimate, se, conf.low, conf.high) |> 
  arrange(po, pid, desc(level)) |> 
  kbl(digits = 3,
      format = "html")
```


Figure B4
```{r}
#| fig-width: 6
plot(timing_coordination_know)
```

Table B4
```{r}
rtop3 |> 
  select(pid, op, level, estimate, se, conf.low, conf.high) |> 
  arrange(op, pid, desc(level)) |> 
  kbl(digits = 3,
      format = "html")
```

 Figure B5
```{r}
#| fig-width: 6
plot(np_pop_know)
```

Table B5
```{r}
nppo3 |> 
  select(pid, po, level, estimate, se, conf.low, conf.high) |> 
  arrange(po, pid, level) |> 
  kbl(digits = 3,
      format = "html")
```

Figure B6
```{r}
#| fig-width: 6
plot(np_coordination_know)
```

Table B6
```{r}
npop3 |> 
  select(pid, op, level, estimate, se, conf.low, conf.high) |> 
  arrange(op, pid, level) |> 
  kbl(digits = 3,
      format = "html")
```



### Appendix C



Table C3
```{r}
mm_all2d |> 
  select(attribute, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "html")
```


Figure C1
```{r}
plot(conjoint2_all_amce)
```

Table C4
```{r}
amce_all2d |> 
  select(attribute, level, estimate, se, conf.low, conf.high) |> 
  kbl(digits = 3,
      format = "html")
```

Table C5
```{r}
rtpo2 |> 
  select(pid, po, level, estimate, se, conf.low, conf.high) |> 
  arrange(po, pid, desc(level)) |> 
  kbl(digits = 3,
      format = "html")
```

Table C6
```{r}
rtop2 |> 
  select(pid, op, level, estimate, se, conf.low, conf.high) |> 
  arrange(op, pid, desc(level)) |> 
  kbl(digits = 3,
      format = "html")
```

Figure C2
```{r}
#| fig-width: 6
print(np_pop_2)
```

Table C7
```{r}
nppo2 |> 
  select(pid, po, level, estimate, se, conf.low, conf.high) |> 
  arrange(po, pid, level) |> 
  kbl(digits = 3,
      format = "html")
```

Figure C3
```{r}
#| fig-width: 6
plot(np_coordination_2)
```

Table C8
```{r}
npop2 |> 
  select(pid, op, level, estimate, se, conf.low, conf.high) |> 
  arrange(op, pid, level) |> 
  kbl(digits = 3,
      format = "html")

```


